#*************************************************************************
#*
#*  $RCSfile$
#*
#*  $Revision$
#*
#*  last change: $Author: wiede $ $Date: 2005-10-19 17:46:51 +0200 (Wed, 19 Oct 2005) $
#*
#*  The Contents of this file are made available subject to the terms of
#*  the following license
#*
#* 	- BSD License
#*
#*	see file license/license.terms in this directory
#*
#*  Copyright 2005 Arnulf Wiedemann
#*
#*  Author: Arnulf Wiedemann
#*
#*  Contributor(s): 
#*
#************************************************************************/

package require Itcl

namespace eval ::tcluno_registry {

# **************************** RegistryKeyEntry ***************************

::itcl::class RegistryKeyEntry {
	private variable _cp_tag_type_infos
	private variable _rt_access_infos
	private variable _rt_type_class_infos
	private variable _byte_sequence
	private variable _byte_sequence_idx
	private variable _start_block_infos
	private variable _num_super_types
	private variable _super_types -1
	private variable _num_cp_entries -1
	private variable _cp_entries
	private variable _indent "        "
	private variable _tab "        "
	private variable _tab2 "       "
	private variable _uik_value {}
	private variable _debug 0
	private variable _num_field_entries
	private variable _num_method_entries
	private variable _field_infos
	private variable _method_infos

	private method _getByteStrFromSalInt8Sequence {idx}
	private method _get1ByteSalInt8Value {}
	private method _get2ByteSalInt8ValueWithIndex {start_idx}
	private method _get2ByteSalInt8Value {}
	private method _getHex2ByteSalInt8ValueWithIndex {start_idx}
	private method _getHex2ByteSalInt8Value {}
	private method _get4ByteSalInt8ValueWithIndex {start_idx}
	private method _get4ByteSalInt8Value {}
	private method _getFloatSalInt8Value {}
	private method _getHex4ByteSalInt8Value {}
	private method _getStartBlockInfo {type}
	private method _getStringFromByteSequence {lgth}
	private method _getUTF8StringFromByteSequence {lgth}
	private method _getCpTagType {}
	private method _extractCpEntry {}

	constructor {args} {} {}

	public method Init {byte_seq}
	
	public method setIndentation {indentation} {
		set _indent $indentation
	}
	public method getCurrIdx {} {
		return $_byte_sequence_idx
	}
	public method getMagic {} {
		return [_getStartBlockInfo MAGIC]
	}
	public method getSize {} {
		return [_getStartBlockInfo SIZE]
	}
	public method getMinorVersion {} {
		return [_getStartBlockInfo MINOR_VERSION]
	}
	public method getMajorVersion {} {
		return [_getStartBlockInfo MAJOR_VERSION]
	}
	public method getNumEntries {} {
		return [_getStartBlockInfo N_ENTRIES]
	}
	public method getIndexTypeSource {} {
		return [_getStartBlockInfo TYPE_SOURCE]
	}
	public method getTypeClass {} {
		return [_getStartBlockInfo TYPE_CLASS]
	}
	public method getIndexThisType {} {
		return [_getStartBlockInfo THIS_TYPE]
	}
	public method getIndexUik {} {
		return [_getStartBlockInfo UIK]
	}
	public method getIndexDoku {} {
		return [_getStartBlockInfo DOKU]
	}
	public method getIndexFileName {} {
		return [_getStartBlockInfo FILE_NAME]
	}
	public method getNumSuperTypes {} {
		return $_num_super_types
	}
	public method getSuperTypeIndex {idx} {
		return $_super_types($idx)
	}
	public method getNumCpEntries {} {
		return $_num_cp_entries
	}
	public method getCpIndex {} {
		return [_get2ByteSalInt8Value]
	}
	public method getCountEntry {} {
		return [_get2ByteSalInt8Value]
	}

	public method getNumberOfFields {}
	public method getFieldAccessInfo {entry_idx}
	public method getFieldNameInfo {entry_idx}
	public method getFieldTypeInfo {entry_idx}
	public method getFieldValueInfo {entry_idx}
	public method getFieldDokuInfo {entry_idx}
	public method getFieldSourceFileInfo {entry_idx}
	public method getFieldInfos {}
	public method getNumberOfMethods {}
	public method getMethodModeInfo {entry_idx}
	public method getMethodNameInfo {entry_idx}
	public method getMethodReturnInfo {entry_idx}
	public method getMethodDokuInfo {entry_idx}
	public method getMethodNumParamsInfo {entry_idx}
	public method getMethodParamTypeNameInfo {entry_idx param_idx}
	public method getMethodParamModeInfo {entry_idx param_idx}
	public method getMethodParamNameInfo {entry_idx param_idx}
	public method getMethodNumExceptionsInfo {entry_idx}
	public method getMethodExceptionInfo {entry_idx exception_idx}
	public method getMethodInfos {}
	public method getSuperTypes {}
	public method getCpEntries {}
	public method getCpEntry {idx}
	public method showHeaders {}
	public method showFields {}
	public method showMethods {}
	public method showReferences {}
	public method showEntry {byte_seq}
}

# **************************** Init ***************************************

::itcl::body RegistryKeyEntry::Init {byte_seq} {
	set _byte_sequence $byte_seq
	set _byte_sequence_idx 26
	catch {unset _cp_entries}
	catch {unset _super_types}
}

# **************************** constructor ********************************

::itcl::body RegistryKeyEntry::constructor {args} {
	set _rt_value_type_infos_old [list \
        RT_TYPE_NONE \
        RT_TYPE_BOOL \
        RT_TYPE_BYTE \
        RT_TYPE_INT16 \
        RT_TYPE_UINT16 \
        RT_TYPE_INT32 \
        RT_TYPE_UINT32 \
        RT_TYPE_INT64 \
        RT_TYPE_UINT64 \
        RT_TYPE_FLOAT \
        RT_TYPE_DOUBLE \
        RT_TYPE_STRING \
	UTF8_NAME \
	UIK \
	]
	set _cp_tag_type_infos [list \
        CP_TAG_INVALID \
        CP_TAG_CONST_BOOL \
        CP_TAG_CONST_BYTE \
        CP_TAG_CONST_INT16 \
        CP_TAG_CONST_UINT16 \
        CP_TAG_CONST_INT32 \
        CP_TAG_CONST_UINT32 \
        CP_TAG_CONST_INT64 \
        CP_TAG_CONST_UINT64 \
        CP_TAG_CONST_FLOAT \
        CP_TAG_CONST_DOUBLE \
        CP_TAG_CONST_STRING \
	CP_TAG_UTF8_NAME \
	CP_TAG_UIK \
	]

	set _rt_access_infos(0x0000) INVALID
	set _rt_access_infos(0x0001) READONLY
	set _rt_access_infos(0x0002) OPTIONAL
	set _rt_access_infos(0x0004) MAYBEVOID
	set _rt_access_infos(0x0008) BOUND
	set _rt_access_infos(0x0010) CONSTRAINED
	set _rt_access_infos(0x0020) TRANSIENT
	set _rt_access_infos(0x0040) MAYBEAMBIGUOUS
	set _rt_access_infos(0x0080) MAYBEDEFAULT
	set _rt_access_infos(0x0100) REMOVEABLE
	set _rt_access_infos(0x0200) ATTRIBUTE
	set _rt_access_infos(0x0400) PROPERTY
	set _rt_access_infos(0x0800) CONST
	set _rt_access_infos(0x1000) READWRITE
	set _rt_access_infos(0x2000) DEFAULT

	set _rt_type_class_infos(0) INVALID
	set _rt_type_class_infos(1) INTERFACE
	set _rt_type_class_infos(2) MODULE
	set _rt_type_class_infos(3) STRUCT
	set _rt_type_class_infos(4) ENUM
	set _rt_type_class_infos(5) EXCEPTION
	set _rt_type_class_infos(6) TYPEDEF
	set _rt_type_class_infos(7) SERVICE
	set _rt_type_class_infos(8) SINGLETON
	set _rt_type_class_infos(9) OBJECT
	set _rt_type_class_infos(10) CONSTANTS
	set _rt_type_class_infos(11) UNION

	set _start_block_infos(MAGIC) [list 0 3]
	set _start_block_infos(SIZE) [list 4 7]
	set _start_block_infos(MINOR_VERSION) [list 8 9]
	set _start_block_infos(MAJOR_VERSION) [list 10 11]
	set _start_block_infos(N_ENTRIES) [list 12 13]
	set _start_block_infos(TYPE_SOURCE) [list 14 15]
	set _start_block_infos(TYPE_CLASS) [list 16 17]
	set _start_block_infos(THIS_TYPE) [list 18 19]
	set _start_block_infos(UIK) [list 20 21]
	set _start_block_infos(DOKU) [list 22 23]
	set _start_block_infos(FILE_NAME) [list 24 25]
}

# **************************** _getByteStrFromSalInt8Sequence *************

::itcl::body RegistryKeyEntry::_getByteStrFromSalInt8Sequence {idx} {
	set val_str [lindex $_byte_sequence $idx]
	scan $val_str "0x%02x" val
	return $val
}

# **************************** _get2ByteSalInt8ValueWithIndex *************

::itcl::body RegistryKeyEntry::_get2ByteSalInt8ValueWithIndex {start_idx} {
	set v1 [_getByteStrFromSalInt8Sequence $start_idx]
	incr start_idx
	set v2 [_getByteStrFromSalInt8Sequence $start_idx]
	set val [expr {$v1*256 + $v2}]
	return $val
}

# **************************** _get1ByteSalInt8Value **********************

::itcl::body RegistryKeyEntry::_get1ByteSalInt8Value {} {
	set val [_getByteStrFromSalInt8Sequence $_byte_sequence_idx]
	incr _byte_sequence_idx
	return $val
}

# **************************** _get2ByteSalInt8Value **********************

::itcl::body RegistryKeyEntry::_get2ByteSalInt8Value {} {
	set v1 [_getByteStrFromSalInt8Sequence $_byte_sequence_idx]
	incr _byte_sequence_idx
	set v2 [_getByteStrFromSalInt8Sequence $_byte_sequence_idx]
	incr _byte_sequence_idx
	set val [expr {$v1*256 + $v2}]
	return $val
}

# **************************** _get4ByteSalInt8ValueWithIndex *************

::itcl::body RegistryKeyEntry::_get4ByteSalInt8ValueWithIndex {start_idx} {
	foreach i "1 2 3 4" {
		set v$i [_getByteStrFromSalInt8Sequence $start_idx]
		incr start_idx
	}
	set val [expr {$v1*256*256*256 + $v2*256*256 + $v3*256 + $v4}]
	return $val
}

# **************************** _get4ByteSalInt8Value **********************

::itcl::body RegistryKeyEntry::_get4ByteSalInt8Value {} {
	foreach i "1 2 3 4" {
		set v$i [_getByteStrFromSalInt8Sequence $_byte_sequence_idx]
		incr _byte_sequence_idx
	}
	set val [expr {$v1*256*256*256 + $v2*256*256 + $v3*256 + $v4}]
	return $val
}

# **************************** _getFloatSalInt8Value **********************

::itcl::body RegistryKeyEntry::_getFloatSalInt8Value {} {
	set val [_getHex4ByteSalInt8Value]
	set str [$::tcluno_soffice::remoteServiceManager tcluno::getFloatFromHexString $val]
	return [format "%.0f" $str]
}

# **************************** _getHex2ByteSalInt8ValueWithIndex **********

::itcl::body RegistryKeyEntry::_getHex2ByteSalInt8ValueWithIndex {start_idx} {
	set val [_get2ByteSalInt8ValueWithIdx $start_idx]
	set val [format "0x%04x" $val]
	return $val
}

# **************************** _getHex2ByteSalInt8Value *******************

::itcl::body RegistryKeyEntry::_getHex2ByteSalInt8Value {} {
	set val [_get2ByteSalInt8Value]
	set val [format "0x%04x" $val]
	return $val
}

# **************************** _getHex4ByteSalInt8Value *******************

::itcl::body RegistryKeyEntry::_getHex4ByteSalInt8Value {} {
	set val [_get4ByteSalInt8Value]
	set val [format "0x%08x" $val]
	return $val
}

# **************************** _getCpTagType ******************************

::itcl::body RegistryKeyEntry::_getCpTagType {} {
	set val [_get2ByteSalInt8Value]
	if {$val > [llength $_cp_tag_type_infos]} {
		puts stderr "invalid CpTagType:$val:"
		return "????"
	}
	return [lindex $_cp_tag_type_infos $val]
}
	
# **************************** _getStartBlockInfo *************************

::itcl::body RegistryKeyEntry::_getStartBlockInfo {type} {
	if {! [info exists _start_block_infos($type)]} {
		puts stderr "bad StartBlockType:$type"
		return "????"
	}
	set indexes $_start_block_infos($type)
	foreach {start_idx end_idx} $indexes break
	switch $type {
	SIZE {
	  	return [_get4ByteSalInt8ValueWithIndex $start_idx]
	  }
	MINOR_VERSION -
	MAJOR_VERSION -
	N_ENTRIES -
	TYPE_SOURCE -
	THIS_TYPE -
	UIK -
	DOKU -
	FILE_NAME -
	N_SUPERTYPES -
	NUM_CP_ENTRIES {
	  	return [_get2ByteSalInt8ValueWithIndex $start_idx]
	  }
	TYPE_CLASS {
	  	set val [_get2ByteSalInt8ValueWithIndex $start_idx]
	  	if {![info exists _rt_type_class_infos($val)]} {
			puts stderr "bad TYPE_CLASS value:$val:"
			return "????"
		}
	  	return $_rt_type_class_infos($val)
	  }
	default {
		return [lrange $_byte_sequence $start_idx $end_idx]
	  }
	}
}

# **************************** _getStringFromByteSequence *****************

::itcl::body RegistryKeyEntry::_getStringFromByteSequence {lgth} {
	set my_str ""
	set idx 0
	while {$idx < $lgth} {
		set byte_code [lindex $_byte_sequence $_byte_sequence_idx]
		incr _byte_sequence_idx
		incr idx
		switch $byte_code {
		"0x00" {
			break
		  }
		}
		if {$idx > $lgth} {
			puts stderr "corrupted String:lgth:$lgth:"
		}
		scan $byte_code "0x%2x" ch
		set ch2 [format "%c" $ch]
		append my_str $ch2
	}
	return $my_str
}

# **************************** _getUTF8StringFromByteSequence *************

::itcl::body RegistryKeyEntry::_getUTF8StringFromByteSequence {lgth} {
	set my_str ""
	set idx 0
	while {$idx < $lgth} {
		set byte_code [lindex $_byte_sequence $_byte_sequence_idx]
		incr _byte_sequence_idx
		incr idx
		switch $byte_code {
		"0x00" {
			break
		  }
		}
		if {$idx > $lgth} {
			puts stderr "corrupted String:lgth:$lgth:"
		}
		scan $byte_code "0x%2x" ch
		set ch2 [format "%c" $ch]
		append my_str $ch2
	}
	return $my_str
}

# **************************** _extractCpEntry ****************************

::itcl::body RegistryKeyEntry::_extractCpEntry {} {
	if {$_debug > 0} {
		puts stderr "ECP:[lrange $_byte_sequence $_byte_sequence_idx [expr $_byte_sequence_idx + 20]]:"
	}
	set lgth [_get4ByteSalInt8Value]
	set cp_tag_type [_getCpTagType]
	if {$_debug > 0} {
		puts stderr "_extractCpEntry:$lgth:$cp_tag_type:"
	}
	switch $cp_tag_type {
	CP_TAG_CONST_STRING {
		incr lgth -6	; # strip off the length and type from lgth
		return [_getStringFromByteSequence $lgth]
	  }
	CP_TAG_UTF8_NAME {
		incr lgth -6	; # strip off the length and type from lgth
		return [_getUTF8StringFromByteSequence $lgth]
	  }
	CP_TAG_CONST_INT16 -
	CP_TAG_CONST_UINT16 {
		set val [_get2ByteSalInt8Value]
	  }
	CP_TAG_CONST_INT32 -
	CP_TAG_CONST_UINT32 {
		set val [_get4ByteSalInt8Value]
	  }
	CP_TAG_CONST_FLOAT {
		set val [_getFloatSalInt8Value]
	  }
	CP_TAG_CONST_BYTE {
		set val [_get1ByteSalInt8Value]
	  }
	CP_TAG_UIK {
		set val1 [_getHex4ByteSalInt8Value]
		set val2 [_getHex2ByteSalInt8Value]
		set val3 [_getHex2ByteSalInt8Value]
		set val4 [_getHex4ByteSalInt8Value]
		set val5 [_getHex4ByteSalInt8Value]
		set val "$val1-$val2-$val3-$val4-$val5"
		set _uik_value $val
	  	return $val
	  }
	default {
	  	puts stderr "_extractCp:cp_tag_type:$cp_tag_type: not yet supported"
		return "????"
	  }
	}
}

# **************************** getSuperTypes ******************************

::itcl::body RegistryKeyEntry::getSuperTypes {} {
	set _num_super_types [_get2ByteSalInt8Value]
	if {$_debug > 0} {
		puts stderr "getSuperTypes:$_num_super_types:"
	}
	set idx 1
	while {$idx <= $_num_super_types} {
		set _super_types($idx) [_get2ByteSalInt8Value]
		if {$_debug > 0} {
			puts stderr "getSuperTypes:$idx:$_super_types($idx):"
		}
		incr idx
	}
}

# **************************** getCpEntries *******************************

::itcl::body RegistryKeyEntry::getCpEntries {} {
	if {$_debug > 0} {
		puts stderr "MM:[lrange $_byte_sequence 0 25]:"
	}
	set _num_cp_entries [_get2ByteSalInt8Value]
	if {$_debug > 0} {
		puts stderr "getCpEntries:$_num_cp_entries:"
	}
	set idx 1
	while {$idx <= $_num_cp_entries} {
		set _cp_entries($idx) [_extractCpEntry]
		if {$_debug} {
			puts stderr "CPE:$idx:$_cp_entries($idx):"
		}
		if {$_debug > 0} {
			puts stderr "getCpEntry:$idx:$_cp_entries($idx):"
		}
		incr idx
	}
}

# **************************** getCpEntry *********************************

::itcl::body RegistryKeyEntry::getCpEntry {idx} {
	if {$idx == 0} {
		return ""
	}
	if {[info exists _cp_entries($idx)]} {
		return $_cp_entries($idx)
	}
	return "????"
}

# **************************** getNumberOfFields ***************************

::itcl::body RegistryKeyEntry::getNumberOfFields {} {
	return $_num_field_entries
}

# **************************** getFieldAccessInfo ***************************

::itcl::body RegistryKeyEntry::getFieldAccessInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	set my_access [format 0x%04x $access_idx]
	if {[info exists _rt_access_infos($my_access)]} {
		return $_rt_access_infos($my_access)
	}
	return "????"
}

# **************************** getFieldNameInfo ***************************

::itcl::body RegistryKeyEntry::getFieldNameInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	return [getCpEntry $name_idx]
}

# **************************** getFieldTypeInfo ***************************

::itcl::body RegistryKeyEntry::getFieldTypeInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	return [getCpEntry $type_idx]
}

# **************************** getFieldValueInfo ***************************

::itcl::body RegistryKeyEntry::getFieldValueInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	return [getCpEntry $value_idx]
}

# **************************** getFieldDokuInfo ***************************

::itcl::body RegistryKeyEntry::getFieldDokuInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	return [getCpEntry $doku_idx]
}

# **************************** getFieldSourceFileInfo ************************

::itcl::body RegistryKeyEntry::getFieldSourceFileInfo {entry_idx} {
	foreach {access_idx name_idx type_idx value_idx doku_idx source_file_idx} $_field_infos($entry_idx) break
	return [getCpEntry $source_file_idx]
}

# **************************** getFieldInfos ********************************

::itcl::body RegistryKeyEntry::getFieldInfos {} {
	catch {unset _field_infos}
	set _num_field_entries [getCountEntry]
	if {$_num_field_entries > 0} {
		set num_infos_per_entry [getCountEntry]
		if {$num_infos_per_entry != 6} {
			puts stderr "corrupted fields entry expected num_infos_per_entry:6 got:$num_infos_per_entry"
			exit 1
		}
		set entry_idx 0
		while {$entry_idx < $_num_field_entries} {
			set access_idx [getCpIndex]
			set name_idx [getCpIndex]
			set type_idx [getCpIndex]
			set value_idx [getCpIndex]
			set doku_idx [getCpIndex]
			set source_file_idx [getCpIndex]
			set _field_infos($entry_idx) [list $access_idx $name_idx $type_idx $value_idx $doku_idx $source_file_idx]
			incr entry_idx
		}
	}
}

# **************************** getNumberOfMethods ***************************

::itcl::body RegistryKeyEntry::getNumberOfMethods {} {
	return $_num_method_entries
}

# **************************** getMethodModeInfo ************************

::itcl::body RegistryKeyEntry::getMethodModeInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return $mode
}

# **************************** getMethodNameInfo ************************

::itcl::body RegistryKeyEntry::getMethodNameInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return [getCpEntry $name_idx]
}

# **************************** getMethodReturnInfo ************************

::itcl::body RegistryKeyEntry::getMethodReturnInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return [getCpEntry $return_idx]
}

# **************************** getMethodDokuInfo ************************

::itcl::body RegistryKeyEntry::getMethodDokuInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return [getCpEntry $doku_idx]
}

# **************************** getMethodNumParamsInfo ************************

::itcl::body RegistryKeyEntry::getMethodNumParamsInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return $num_params
}

# **************************** getMethodParamTypeNameInfo ************************

::itcl::body RegistryKeyEntry::getMethodParamTypeNameInfo {entry_idx param_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	set param_info [lindex $param_infos $param_idx]
	foreach {param_type_name_idx param_mode param_name_idx} $param_info break
	return [getCpEntry $param_type_name_idx]
}

# **************************** getMethodParamModeInfo ************************

::itcl::body RegistryKeyEntry::getMethodParamModeInfo {entry_idx param_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	set param_info [lindex $param_infos $param_idx]
	foreach {param_type_name_idx param_mode param_name_idx} $param_info break
	return $param_mode
}

# **************************** getMethodParamNameInfo ************************

::itcl::body RegistryKeyEntry::getMethodParamNameInfo {entry_idx param_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	set param_info [lindex $param_infos $param_idx]
	foreach {param_type_name_idx param_mode param_name_idx} $param_info break
	return [getCpEntry $param_name_idx]
}

# **************************** getMethodNumExceptionsInfo ************************

::itcl::body RegistryKeyEntry::getMethodNumExceptionsInfo {entry_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	return $num_exceptions
}

# **************************** getMethodExceptionInfo ************************

::itcl::body RegistryKeyEntry::getMethodExceptionInfo {entry_idx exception_idx} {
	foreach {mode name_idx return_idx doku_idx num_params param_infos num_exceptions exception_infos} $_method_infos($entry_idx) break
	set exception_info [lindex $exception_infos $exception_idx]
	foreach {exception_name_idx} $exception_info break
	return [getCpEntry $exception_name_idx]
}

# **************************** getMethodInfos ********************************

::itcl::body RegistryKeyEntry::getMethodInfos {} {
	catch {unset _method_infos}
	set _num_method_entries [getCountEntry]
	if {$_num_method_entries > 0} {
		set num_method_infos_per_entry [getCountEntry]
		if {$num_method_infos_per_entry != 5} {
			puts stderr "corrupted methods entry expected num_method_infos_per_entry:5 got:$num_method_infos_per_entry"
			exit 1
		}
		set num_param_infos_per_entry [getCountEntry]
		if {$num_param_infos_per_entry != 3} {
			puts stderr "corrupted methods entry expected num_param_infos_per_entry:5 got:$num_param_infos_per_entry"
			exit 1
		}
		set entry_idx 0
		set cnt 0
		while {$entry_idx < $_num_method_entries} {
			set method_entry_size [getCountEntry]
			set method_mode [getCountEntry]
			set method_name_idx [getCpIndex]
			set method_return_idx [getCpIndex]
			set method_doku_idx [getCpIndex]
			set method_num_params [getCountEntry]
			set param_infos [list]
			set param_cnt 0
			while {$param_cnt < $method_num_params} {
				set param_type_name_idx [getCpIndex]
				set param_mode [getCountEntry]
				set param_name_idx [getCpIndex]
				lappend param_infos [list $param_type_name_idx $param_mode $param_name_idx]
				incr param_cnt
			}
			set method_num_exceptions [getCountEntry]
			set exception_infos [list]
			set exception_cnt 0
			while {$exception_cnt < $method_num_exceptions} {
				set exception_name_idx [getCpIndex]
				lappend exception_infos $exception_name_idx
				incr exception_cnt
			}
			set _method_infos($entry_idx) [list $method_mode $method_name_idx $method_return_idx $method_doku_idx $method_num_params $param_infos $method_num_exceptions $exception_infos]
			incr entry_idx
		}
	}
}

# **************************** showHeaders ********************************

::itcl::body RegistryKeyEntry::showHeaders {} {
	if {$_debug} {
		puts stderr "info:[lrange $_byte_sequence 30 end]"
		puts stderr "N_ENTRIES:[getNumEntries]:"
		puts stderr "TYPE_SOURCE:[getIndexTypeSource]:"
		puts stderr "THIS_TYPE:[getIndexThisType]:"
		puts stderr "UIK:[getIndexUik]:"
		puts stderr "DOKU:[getIndexDoku]:"
		puts stderr "FILE_NAME:[getIndexFileName]:"
		puts stderr "N_SUPER_TYPES:[getNumSuperTypes]:"
		puts stderr "CP_ENTRIES:[getNumCpEntries]:"
	}
	set uik_idx [getIndexUik]
	puts "${_indent}${_tab}Size = [getSize]"
	puts "${_indent}${_tab}Data = minor version: [getMinorVersion]"
	puts "${_indent}${_tab}${_tab2}major version: [getMajorVersion]"
	puts "${_indent}${_tab}${_tab2}type: '[string tolower [getTypeClass]]'"
	if {$uik_idx > 0} {
		puts "${_indent}${_tab}${_tab2}uik: \{ [getCpEntry $uik_idx] \}"
	}
	puts "${_indent}${_tab}${_tab2}name: '[getCpEntry [getIndexThisType]]'"
	set num_super_types [getNumSuperTypes]
	set idx 1
	set str ""
	set sep ""
	while {$idx <= $num_super_types} {
		set my_idx $_super_types($idx)
		append str "$sep[getCpEntry $my_idx]"
		set sep ", "
		incr idx
	}
	puts "${_indent}${_tab}${_tab2}super name: '$str'"
	puts "${_indent}${_tab}${_tab2}Doku: \"[getCpEntry [getIndexDoku]]\""
	puts "${_indent}${_tab}${_tab2}IDL source file: \"[getCpEntry [getIndexFileName]]\""
}

# **************************** showFields ********************************

::itcl::body RegistryKeyEntry::showFields {} {
	getFieldInfos
	set num_entries $_num_field_entries
	puts "${_indent}${_tab}${_tab2}number of fields: $num_entries"
	if {$num_entries > 0} {
		set cnt 0
		while {$cnt < $num_entries} {
			puts "${_indent}${_tab}${_tab2}field #$cnt:"
			set access [getFieldAccessInfo $cnt]
			puts "${_indent}${_tab}${_tab2}  name='[getFieldNameInfo $cnt]'"
			puts "${_indent}${_tab}${_tab2}  type='[getFieldTypeInfo $cnt]'"
			puts "${_indent}${_tab}${_tab2}  access=$access"
			set value [getFieldValueInfo $cnt]
			if {[string length $value] == 0} {
				puts ""
			} else {
				puts "${_indent}${_tab}${_tab2}  value = $value"
			}
			puts "${_indent}${_tab}${_tab2}  Doku: \"[getFieldDokuInfo $cnt]\""
			puts "${_indent}${_tab}${_tab2}  IDL source file: \"[getFieldSourceFileInfo $cnt]\""
			incr cnt
		}
	}
}

# **************************** showMethods ********************************

::itcl::body RegistryKeyEntry::showMethods {} {
	getMethodInfos
	set num_entries $_num_method_entries
	puts "${_indent}${_tab}${_tab2}number of methods: $num_entries"
	if {$num_entries > 0} {
		set cnt 0
		while {$cnt < $num_entries} {
			puts -nonewline "${_indent}${_tab}${_tab2}method #$cnt:"
#puts stderr "MODE:$method_mode"
			set method_mode [getMethodModeInfo $cnt]
			switch $method_mode {
			1 {
				set mode_str " \[oneway\]"
			  }
			default {
			  	set mode_str ""
			  }
			}
			puts -nonewline "$mode_str [getMethodReturnInfo $cnt] "
			puts -nonewline "[getMethodNameInfo $cnt]("
			set param_cnt 0
			set sep ""
			set method_num_params [getMethodNumParamsInfo $cnt]
			while {$param_cnt < $method_num_params} {
				set param_mode [getMethodParamModeInfo $cnt $param_cnt]
				switch $param_mode {
				1 {
				  	set mode "\[in\]"
				  }
				2 {
				  	set mode "\[out\]"
				  }
				3 {
				  	set mode "\[inout\]"
				  }
				default {
				  	set mode "\[??$param_mode\]"
				  }
				}
				puts -nonewline "$sep$mode"
				puts -nonewline " [getMethodParamTypeNameInfo $cnt $param_cnt]"
				puts -nonewline " [getMethodParamNameInfo $cnt $param_cnt]"
				set sep ", "
				incr param_cnt
			}
			puts -nonewline ")"
			set method_num_exceptions [getMethodNumExceptionsInfo $cnt]
			set sep " raises "
			set exception_cnt 0
			while {$exception_cnt < $method_num_exceptions} {
				puts -nonewline "$sep[getMethodExceptionInfo $cnt $exception_cnt]"
				set sep ", "
				incr exception_cnt
			}
			puts ""
			puts "${_indent}${_tab}${_tab2}  Doku: \"[getMethodDokuInfo $cnt]\""
			incr cnt
		}
	}
}

# **************************** showReferences *****************************

::itcl::body RegistryKeyEntry::showReferences {} {
	set num_entries [getCountEntry]
	puts "${_indent}${_tab}${_tab2}number of references: $num_entries"
	if {$num_entries > 0} {
		set num_infos_per_entry [getCountEntry]
		if {$num_infos_per_entry != 6} {
			puts stderr "corrupted references entry expected num_infos_per_entry:6 got:$num_infos_per_entry"
			exit 1
		}
		set cnt 0
		while {$cnt < $num_entries} {
			puts stderr "${_indent}field #$cnt:"
			incr cnt
			set access [getAccessInfo]
			set val [getCpIndex]
			puts "${_indent}${_tab}${_tab2}  name='[getCpEntry $val]'"
			set val [getCpIndex]
			puts "${_indent}${_tab}${_tab2}  type='[getCpEntry $val]'"
			puts "${_indent}${_tab}${_tab2}  access=$access"
			set val [getCpIndex]
			puts "${_indent}${_tab}${_tab2}  value = [getCpEntry $val]"
			set val [getCpIndex]
			puts "${_indent}${_tab}${_tab2}  Doku: \"[getCpEntry $val]\""
			set val [getCpIndex]
			puts "${_indent}${_tab}${_tab2}  IDL source file: \"[getCpEntry $val]\""
		}
	}
}

# **************************** showEntry **********************************

::itcl::body RegistryKeyEntry::showEntry {byte_seq} {
	Init $byte_seq
	getSuperTypes 
	getCpEntries 
	showHeaders
	showFields
	showMethods
	showReferences
}

}

package provide tcluno_registry 0.0
